home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / pcpm.arc / CPACPM.BAS < prev    next >
Encoding:
BASIC Source File  |  1985-06-04  |  9.5 KB  |  288 lines
  1. 10 REM **** CPACPM ****
  2. 30 CLOSE
  3. 40 ON ERROR GOTO 7800
  4. 240 DEFINT B-Z:DEFSNG A
  5. 250 DIM S(500),F(500),E(1000),L(1000),D$(500),D(500),O2(500)
  6. 260 DIM A(1500),P(500),A3(100),B(500),S$(48)
  7. 290 DIM X$(12),A6(500)
  8. 302 DEF FNF1(I)=L(F(I))-E(S(I))-D(I)   'FLOAT
  9. 304 DEF FNS2(I)=L(F(I))-D(I)   'LATE START
  10. 306 DEF FNF2(I)=E(S(I))+D(I)   'EARLY FINISH
  11. 310 FOR I=1 TO 12
  12. 320 READ X$(I)
  13. 330 NEXT I
  14. 340 DATA "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
  15. 380 B4=VAL(MID$(DATE$,1,2))
  16. 390 B5=VAL(MID$(DATE$,4,2))
  17. 400 B6=VAL(MID$(DATE$,9,2))
  18. 440 F9=0:PRINT:GOSUB 5010
  19. 485 IF LEFT$(T6$,3)<>"WOR" AND LEFT$(T6$,3)<>"CAL" THEN T7=1 ELSE T7=0
  20. 490 PRINT FRE(0)
  21. 491 FOR I=2 TO N:IF S(I)<S(I-1) THEN 495
  22. 492 NEXT
  23. 493 PRINT "**** BYPASSING SORT ROUTINE ****"
  24. 494 FOR I=1 TO N:P(I)=I:NEXT:GOTO 497
  25. 495 PRINT "**** SORTING"N"ACTIVITIES - TAKES";N/4;"SECONDS IN REGULAR BASIC ****":GOSUB 7370
  26. 497 H$=F$+".OUT"
  27. 500 PRINT "The Output Filename is ";H$;" O.K. (Y/N) ";Q$;
  28. 501 INPUT Q$
  29. 502 IF LEFT$(Q$,1)<>"N" THEN 510
  30. 505 INPUT "Enter the Output File Name ";H$
  31. 507 REM GOSUB 10000 'TEST FILE NAME
  32. 508 GOTO 500
  33. 510 OPEN H$ FOR OUTPUT AS #2
  34. 520 OPEN F$+".LGS" FOR OUTPUT AS #3  ' SORT FILE
  35. 530 INPUT "Want to adjust for reported finish times (Y/N) ";Q2$
  36. 540 IF LEFT$(Q2$,1)="N" THEN F5=0 ELSE F5=1
  37. 570 L(S(P(1)))=0   '******GUTS OF CPA*************************************
  38. 580 FOR I=1 TO N
  39. 590 E(S(I))=0
  40. 600 L(F(I))=-5000
  41. 610 NEXT I
  42. 620 E(F(P(N)))=0
  43. 630 FOR I=1 TO N
  44. 640 M1=E(S(P(I)))+D(P(I))
  45. 650 IF E(F(P(I)))<=M1 THEN E(F(P(I)))=M1
  46. 660 NEXT I
  47. 670 L(F(P(N)))=E(F(P(N)))
  48. 680 FOR I=N TO 1 STEP -1
  49. 690 L1=S(P(I))
  50. 700 M2=L(F(P(I)))-D(P(I))
  51. 710 IF L(L1)>=M2 OR L(L1)=-5000 THEN L(L1)=M2
  52. 720 NEXT I
  53. 730 C3=L(F(P(N)))
  54. 740 PRINT "**** PROJECT LENGTH IS";C3;T6$;" ****"
  55. 741 IF F9=1 THEN 930
  56. 742 PRINT "**** THIS WILL TAKE"C3/2*(F5+1)"SECONDS IN REGULAR BASIC ****":BEEP
  57. 750 IF F5=1 THEN M9=C3*2 ELSE M9=C3+1
  58. 770 IF T7=1 THEN 1110
  59. 780 IF A(1)<>0 THEN 930
  60. 820 D1=1
  61. 830 GOSUB 7010           'GET DAY OF CENTURY - A8
  62. 845 GOSUB 8000  'READ HOLIDAYS
  63. 920 GOSUB 7090     'CREATE ARRAY OF MMDDYYS
  64. 930 A7=A(C3+1)
  65. 950 GOSUB 7550    'CONVERT TO STRING
  66. 960 PRINT " **** END DATE IS ";P6$;" ****"
  67. 990 IF F5=1 THEN 7660
  68. 1110 G1=5000                  'ARBITRARILY HIGH
  69. 1120 FOR I=1 TO N
  70. 1130 IF FNF1(P(I))<G1 THEN G1=FNF1(P(I))
  71. 1140 NEXT I
  72. 1150 WRITE #3,A9,A(1),C3
  73. 1160 PRINT "**** READING SUBCONTRACTORS ****"
  74. 1161 REM ON ERROR GOTO 1200
  75. 1162 OPEN F$+".SBC" FOR INPUT AS #1
  76. 1164 J=0
  77. 1166 J=J+1
  78. 1168 IF EOF(1) THEN 1180
  79. 1170 INPUT #1,S$(J)
  80. 1172 IF J=48 THEN 1180
  81. 1174 GOTO 1166
  82. 1180 CLOSE #1:GOTO 1240
  83. 1200 PRINT "**** NO SUBCONTRACTOR FILE - CONTINUING ****"
  84. 1240 PRINT " **** OUTPUTTING ANALYSIS AND SORT FILE ****"
  85. 1250 IF LEN(P$)>60 THEN P1$=LEFT$(P$,60) ELSE P1$=P$
  86. 1260 T4=INT((118-52-LEN(P1$))/2)
  87. 1270 PRINT #2,TAB(T4);"CRITICAL PATH ANALYSIS FOR: ";P1$;" RUN DATE: ";X$(B4);B5;", 19";RIGHT$(STR$(B6),2)
  88. 1280 PRINT #2,G9$
  89. 1290 T4=((120-15-LEN(T6$))/2)
  90. 1300 PRINT #2,TAB(T4);"TIME PERIOD = ";T6$
  91. 1310 PRINT #2,G9$
  92. 1320 W4$=" DESCRIPTION                     "
  93. 1330 W$="ACTIVITY"+W4$+"FROM   TO  EST. ACTUAL  EARLY    LAST     EARLY    LAST  FLOAT C REPORT  SUBCONTRACTOR"
  94. 1340 W1$="NODE  NODE TIME  TIME   START    START    FINISH  FINISH  TIME P FINISH      NAME"
  95. 1350 PRINT #2,W$
  96. 1360 PRINT #2,TAB(42);W1$
  97. 1370 PRINT #2,G9$
  98. 1380 S4$="\                                      \"
  99. 1390 S5$=" \     \  \     \ "
  100. 1400 S$=S4$+" #### #### ####  ####  "+S5$+S5$+"#### ! \     \ \          \"
  101. 1410 S1$=S4$+" , #### , #### , #### , #### , #### , #### , #### , #### , #### , \     \ , ## "
  102. 1420 FOR I=1 TO N
  103. 1440 IF T7=1 THEN A7=L(F(I))+1 ELSE A7=A(L(F(I))+1)
  104. 1460 GOSUB 7550
  105. 1470 R4$=P6$
  106. 1480 IF T7=1 THEN A7=E(S(I))+1 ELSE A7=A(E(S(I))+1)
  107. 1500 GOSUB 7550
  108. 1510 R1$=P6$
  109. 1520 IF T7=1 THEN A7=FNS2(I)+1 ELSE A7=A(FNS2(I)+1)
  110. 1540 GOSUB 7550
  111. 1550 R2$=P6$
  112. 1560 IF T7=1 THEN A7=FNF2(I)+1 ELSE A7=A(FNF2(I)+1)
  113. 1580 GOSUB 7550
  114. 1590 R3$=P6$
  115. 1600 IF A6(I)=0 THEN R6$="":GOTO 1660
  116. 1630 A7=A6(I)
  117. 1640 GOSUB 7550
  118. 1650 R6$=P6$
  119. 1660 IF FNF1(I)=G1 THEN G1$="*" ELSE G1$=" "
  120. 1670 PRINT #2,USING S$;D$(I),S(I),F(I),O2(I),D(I),R1$,R2$,R3$,R4$,FNF1(I),G1$,R6$,S$(B(I))
  121. 1680 PRINT #3,USING S1$;D$(I),S(I),F(I),O2(I),D(I),E(S(I)),FNS2(I),FNF2(I),L(F(I)),FNF1(I),R6$,B(I)
  122. 1690 NEXT I
  123. 1700 CLOSE #3
  124. 1710 IF LEFT$(Q2$,1)="N" THEN 1845
  125. 1720 INPUT "Want to create an updated schedule (Y/N) ";Q$
  126. 1840 IF LEFT$(Q$,1)="N" THEN 1845 ELSE GOSUB 7820
  127. 1845 PRINT "**** FINISHED CPM - WRITING CRITICAL PATH LIST TO FILE ****"
  128. 1850 PRINT #2,G9$
  129. 1860 PRINT #2," THE CRITICAL PATH LENGTH IS";C3;
  130. 1880 PRINT #2,G9$
  131. 1890 PRINT #2," COMPLETE LIST OF CRITICAL PATH ACTIVITIES (THOSE ACTIVITIES DENOTED ABOVE BY *)"
  132. 1900 PRINT #2,G9$
  133. 1910 PRINT #2," ACTIVITY DESCRIPTION";SPC(19);
  134. 1920 PRINT #2,"FROM NODE TO NODE  DURATION  CUM.TIME"
  135. 1930 PRINT #2," ----------------------------------------------------------------------------"
  136. 1940 S5$="  \                                     \ ####     ####     ####     #####"
  137. 1960 K3=0:K=0:E(S(1))=0:S9=0
  138. 1990 FOR I=1 TO N
  139. 2000 IF FNF1(P(I))<>G1 THEN 2030
  140. 2010 K=K+1
  141. 2020 L(K)=P(I)
  142. 2030 NEXT I
  143. 2040 S8=D(L(1))+S9
  144. 2050 J=0:I=1:GOSUB 7610:IF K=1 THEN 2335 ELSE F5=F(L(1))
  145. 2100 FOR I=2 TO K
  146. 2110 IF S(L(I))<>F5 THEN 2160
  147. 2120 S8=S8+D(L(I))
  148. 2130 GOSUB 7610
  149. 2140 F5=F(L(I))
  150. 2150 GOTO 2190
  151. 2160 J=J+1
  152. 2170 S(J)=L(I)
  153. 2180 IF J=1 THEN S9=E(S(L(I)))
  154. 2190 NEXT I
  155. 2200 PRINT #2,G9$:K3=K3+1
  156. 2220 IF K3=1 THEN PRINT #2,TAB(10);
  157. 2230 PRINT #2,TAB(24);"PATH ENDS AT NODE";F(L(K4));
  158. 2240 IF K3<>1 THEN PRINT #2,"REJOINING PRIOR PATH" ELSE PRINT #2,G9$
  159. 2250 IF J=0 THEN 2335
  160. 2260 PRINT #2,G9$
  161. 2270 PRINT #2,"                        CRITICAL PATH NUMBER";K3+1;"STARTING AT NODE";S(S(1))
  162. 2280 PRINT #2,G9$
  163. 2290 FOR I=1 TO J:L(I)=S(I):NEXT I:K=J:GOTO 2040
  164. 2335 CHAIN "CPAMENU"
  165. 5000 REM **** READING IN ALREADY CREATED INPUT FILE ******************
  166. 5010 INPUT "Enter the name of the input file [.CPM] ";G$
  167. 5015 IF G$="Q" OR G$="QUIT" THEN 2335
  168. 5020 P=INSTR(1,G$,"."):IF P<>0 THEN F$=LEFT$(G$,INSTR(1,G$,".")-1) ELSE F$=G$
  169. 5030 IF LEN(F$)>8 THEN PRINT "**** NOT A VALID PCPM FILE ****":BEEP:GOTO 5010
  170. 5035 REM ON ERROR GOTO 5300
  171. 5037 G$=F$+".CPM"
  172. 5040 OPEN G$ FOR INPUT AS #3
  173. 5050 INPUT #3,P$,T6$,DA$
  174. 5060 I=0
  175. 5070 I=I+1
  176. 5080 IF EOF(3) THEN 5120
  177. 5090 INPUT #3,D$(I),S(I),F(I),O2(I),D(I),A6(I),PC,B(I),CT
  178. 5100 IF I/10=INT(I/10) THEN PRINT I;
  179. 5110 GOTO 5070
  180. 5120 N=I-1
  181. 5125 IF LEN(DA$)=5 THEN DA$=" "+DA$
  182. 5130 AM6=VAL(LEFT$(DA$,2)):D6=VAL(MID$(DA$,3,2)):Y6=VAL(RIGHT$(DA$,2))
  183. 5140 CLOSE #3
  184. 5150 PRINT " **** INPUT FILE READ ****"
  185. 5160 RETURN
  186. 5300 PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****":BEEP:GOTO 5000
  187. 7000 REM ** GET DAY OF CENTURY OF STARTING DATE ************************
  188. 7010 L8=2
  189. 7020 IF INT(Y6/4)=Y6/4 THEN L8=1
  190. 7030 D7=INT(AM6*275/9)+D6-30
  191. 7040 IF AM6>2 THEN D7=D7-L8
  192. 7050 A8=INT((Y6-1)*365.25)+D7
  193. 7060 A9=A8
  194. 7070 RETURN
  195. 7080 REM ** CREATE ARRAY OF MMDDYYS ******************************
  196. 7090 A(1)=AM6*10000+D6*100+Y6
  197. 7100 D1=D1+1
  198. 7110 IF D1>M9 THEN RETURN
  199. 7120 A8=A8+1
  200. 7130 GOSUB 7210
  201. 7140 IF LEFT$(T6$,3)="CAL" THEN 7150 ELSE IF D4=6 OR D4=7 THEN 7120
  202. 7150 O8=0
  203. 7160 GOSUB 7320
  204. 7170 IF O8=1 THEN 7120
  205. 7180 A(D1)=AM5*10000+D5*100+Y5
  206. 7190 GOTO 7100
  207. 7200 REM ** CONVERT CENTURY DAY TO MM, DD, YY **************************
  208. 7210 T9=INT(A8/1461)
  209. 7220 Y5=INT((A8-T9+364)/365)
  210. 7230 Y4=A8-INT((Y5-1)*365.25)
  211. 7240 L8=2
  212. 7250 IF Y5/4=INT(Y5/4) THEN L8=1
  213. 7260 T9=Y4
  214. 7270 IF T9>61-L8 THEN T9=T9+L8
  215. 7280 AM5=INT((T9*9+269)/275)
  216. 7290 D5=T9-INT(AM5*275/9)+30
  217. 7300 D4=A8-INT(A8/7)*7+1
  218. 7310 RETURN
  219. 7320 FOR J=1 TO H9   '**** HOLIDAY OR NOT ***********************************
  220. 7330 IF A8=A3(J) THEN O8=1
  221. 7340 NEXT J
  222. 7350 RETURN
  223. 7360 REM **** SHELL METZNER SORT ****************************************
  224. 7370 J=N
  225. 7380 FOR I=1 TO N:P(I)=J:J=J-1:NEXT I
  226. 7390 M=N
  227. 7400 M=INT(M/2)
  228. 7410 IF M=0 THEN RETURN
  229. 7420 J=1
  230. 7430 K=N-M
  231. 7440 I=J
  232. 7450 L=I+M
  233. 7460 IF S(P(I))<S(P(L)) THEN 7510
  234. 7470 SWAP P(I),P(L)
  235. 7480 I=I-M
  236. 7490 IF I<1 THEN 7510
  237. 7500 GOTO 7450
  238. 7510 J=J+1
  239. 7520 IF J>K THEN 7400
  240. 7530 GOTO 7440
  241. 7540 REM **** CONVERT TO MONTH DAY YEAR IN STRING FORMAT ****
  242. 7550 P6$=STR$(A7)
  243. 7560 IF T7=1 THEN 7600
  244. 7570 IF LEN(P6$)=6 THEN P6$=" "+P6$
  245. 7580 U9=VAL(LEFT$(P6$,3))
  246. 7590 P6$=X$(U9)+RIGHT$(P6$,4)
  247. 7600 RETURN
  248. 7610 REM *** BEGINNING OF PRINT SUBROUTINE ****
  249. 7620 PRINT #2,USING S5$;D$(L(I)),S(L(I)),F(L(I)),D(L(I)),S8
  250. 7630 K4=I
  251. 7640 E(F(L(I)))=S8
  252. 7650 RETURN
  253. 7660 I5=0  '****SUBROUTINE TO CHECK REPORT FINISHES ****
  254. 7670 I5=I5+1
  255. 7680 IF I5>N THEN 1110
  256. 7690 IF A6(I5)=0 THEN 7670
  257. 7700 FOR J=1 TO C3+1
  258. 7710 IF A6(I5)=A(J) THEN 7750
  259. 7720 NEXT J
  260. 7730 PRINT "**** BAD DATE:";A6(I5);"FOR: ";D$(I5);" - NO ADJUSTMENT ****"
  261. 7740 GOTO 7670
  262. 7750 J=J-1  'J=DAY NUMBER CORRESPONDING TO REPORT FINISH
  263. 7760 IF J<>FNF2(I5) THEN D(I5)=D(I5)-(FNF2(I5)-J) ELSE 7670
  264. 7770 PRINT "**** ADJUSTED TIME OF ";D$(I5);" TO";D(I5);"****"
  265. 7780 PRINT " **** RECALCULATING TIMES **** "
  266. 7790 F9=1:GOTO 570
  267. 7800 PRINT "**** IBM PC/XT ERROR NUMBER"ERR"AT"ERL
  268. 7810 END
  269. 7820 OPEN F$+".UPD" FOR OUTPUT AS #1
  270. 7870 WRITE #1,B4,B5,B6
  271. 7880 FOR I=1 TO N
  272. 7890 WRITE #1,D$(I),S(I),F(I),D(I),A6(I)
  273. 7900 NEXT I
  274. 7910 PRINT "**** CAUTION: YOU MUST CONSOLIDATE UPDATE FILES BEFORE CALLING NEW OPTIONS ****"
  275. 7920 CLOSE #1:RETURN
  276. 8000 REM ON ERROR GOTO 8200
  277. 8010 OPEN F$+".HOL" FOR INPUT AS #1
  278. 8020 J=0
  279. 8030 J=J+1
  280. 8040 IF EOF(1) THEN 8100
  281. 8050 INPUT #1,A3(J)
  282. 8060 GOTO 8030
  283. 8100 H9=J-1  'NUMBER OF HOLIDAYS
  284. 8110 CLOSE #1:RETURN
  285. 8200 PRINT "**** NO HOLIDAY FILE - CONTINUING ****":RESUME 8110
  286. 10000 REM SUBROUTINE TO CHECK FILENAME
  287. 10010 RETURN
  288.